home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d12 / vol7n2.arc / TP4.FIG < prev   
Text File  |  1987-12-23  |  20KB  |  684 lines
  1. Fig. A -- Heading for an Interrupt Procedure
  2.  
  3. PROCEDURE foo(_Flags, _CS, _IP, _AX, _BX, _CX, _DX, _SI, _DI, _DS, _ES,
  4. _BP:Word);INTERRUPT;
  5.  
  6.  
  7. Fig. B -- Special prelude and postlude code created by TP4 for an Interrupt
  8. Procedure
  9.  
  10.  50           PUSH   AX
  11.  53           PUSH   BX
  12.  51           PUSH   CX
  13.  52           PUSH   DX
  14.  56           PUSH   SI
  15.  57           PUSH   DI
  16.  1E           PUSH   DS
  17.  06           PUSH   ES
  18.  55           PUSH   BP
  19.  89E5         MOV    BP,SP
  20.  81ECxxxx     SUB    SP,LocalSize
  21.  B8yyyy       MOV    AX,SEG DATA
  22.  8ED8         MOV    DS,AX
  23.  {Body of procedure goes here}
  24.  89EC         MOV    SP,BP
  25.  5D           POP    BP
  26.  07           POP    ES
  27.  1F           POP    DS
  28.  5F           POP    DI
  29.  5E           POP    SI
  30.  5A           POP    DX
  31.  59           POP    CX
  32.  5B           POP    BX
  33.  58           POP    AX
  34.  CF           IRET
  35.  
  36. Fig. C -- An chaining Interrupt Procedure
  37.  
  38. PROGRAM Shift_Key_Pressed;
  39.   Uses crt, dos, hexx;
  40.   (*The hexx Unit is described elsewhere in this article*)
  41. VAR
  42.   Kbd_Vec, Exit_Vec : pointer;
  43. CONST
  44.   Kbd_Int = 9;
  45.   (* Scan codes for seven shift keys *)
  46.   SC_LeftShift  = 42;
  47.   SC_RightShift = 54;
  48.   SC_CtrlShift  = 29;
  49.   SC_AltShift   = 56;
  50.   SC_NumLock    = 69;
  51.   SC_ScrollLock = 70;
  52.   SC_CapsLock   = 58;
  53.   SKP : Boolean = False;
  54.   which : Byte  = 0;
  55.  
  56.   {$F+} PROCEDURE My_Exit;   {$F-}
  57.   BEGIN
  58.     SetIntVec(Kbd_Int, Kbd_vec); {restore OLD INT9}
  59.     IF (ExitCode <> 0) OR (ErrorAddr <> NIL) THEN
  60.       BEGIN
  61.         Assign(Output, '');
  62.         Rewrite(Output);
  63.         WriteLn(#7);
  64.         IF ExitCode = $FF THEN
  65.           WriteLn('USER BREAK')
  66.         ELSE
  67.           BEGIN
  68.             Write('Critical Error # ', HEX(ExitCode));
  69.             Write(' AT PROGRAM LOCATION ');
  70.             WriteLn(Hex(Seg(ErrorAddr^)), ':', Hex(Ofs(ErrorAddr^)));
  71.           END;
  72.       END;
  73.     ExitProc := Exit_Vec;     {restore previous ExitProc}
  74.   END;
  75.  
  76.   PROCEDURE CLI; INLINE($FA); {INLINE procedures are handy!}
  77.   PROCEDURE STI; INLINE($FB);
  78.  
  79.   PROCEDURE INT9_ISR(_Flags, _CS, _IP, _AX, _BX, _CX, _DX,
  80.                          _SI, _DI, _DS, _ES, _BP : word);
  81.   INTERRUPT;
  82.   BEGIN
  83.     INLINE(
  84.       $9C/                {PUSHF ;save flags }
  85.       $E4/$60/            {IN AL, 60h ;Read the keyboard port }
  86.       $3C/SC_CapsLock/    {CMPB AL,SC_CapsLock  }
  87.       $74/$1F/            {JZ Was_Pressed       }
  88.       $3C/SC_LeftShift/   {CMPB AL,SC_LeftShift }
  89.       $74/$1B/            {JZ Was_Pressed       }
  90.       $3C/SC_RightShift/  {CMPB AL,SC_RightShift}
  91.       $74/$17/            {JZ Was_Pressed       }
  92.       $3C/SC_CtrlShift/   {CMPB AL,SC_CtrlShift }
  93.       $74/$13/            {JZ Was_Pressed       }
  94.       $3C/SC_AltShift/    {CMPB AL,SC_AltShift  }
  95.       $74/$0F/            {JZ Was_Pressed       }
  96.       $3C/SC_NumLock/     {CMPB AL,SC_NumLock   }
  97.       $74/$0B/            {JZ Was_Pressed       }
  98.       $3C/SC_ScrollLock/  {CMPB AL,SC_ScrollLock}
  99.       $74/$07/            {JZ Was_Pressed       }
  100.  
  101.       {IF you didn't jump by now, it wasn't a shift key}
  102.       $C6/$06/SKP/$00/    {MOVB SKP,0 ;set SKP to false    }
  103.       $EB/$08/            {JMP To_Normal}
  104.  
  105.       {Was_Pressed}
  106.       $C6/$06/SKP/$01/    {MOVB SKP,1 ;set SKP to true       }
  107.       $A2/which/          {MOVB which,AL ;remember WHICH key    }
  108.  
  109.       {To_Normal}
  110.       $9D/                {POPF ;Get back saved flags   }
  111.       $A1/> Kbd_vec+2/    {MOV AX,Kbd_vec+2 ; vector segment }
  112.       $8B/$1E/> Kbd_vec/  {MOV BX,Kbd_vec   ; vector offset  }
  113.       $87/$5E/$0E/        {XCHG BX,[BP+14]  ; switch ofs/bx  }
  114.       $87/$46/$10/        {XCHG AX,[BP+16]  ; switch seg/ax  }
  115.  
  116.       $8B/$E5/            {MOV SP,BP ;UNdo what TURBO did at }
  117.       $5D/                {POP BP    ;start of this routine}
  118.       $07/                {POP ES    ;It does a lot more than TP3!}
  119.       $1F/                {POP DS}
  120.       $5F/                {POP DI}
  121.       $5E/                {POP SI}
  122.       $5A/                {POP DX}
  123.       $59/                {POP CX}
  124.       $CB                 {RETF ; effectively "JMP [Kbd_vec]" }
  125.       );
  126.   END;
  127.  
  128.   FUNCTION ShiftKeyPressed : Boolean;
  129.     (* ======================================= *)
  130.     (* Returns the value of flag variable SKP, *)
  131.     (* and resets it to FALSE                  *)
  132.     (* ======================================= *)
  133.   BEGIN
  134.     CLI; {Don't want it changing DURING this!}
  135.     ShiftKeyPressed := SKP;
  136.     SKP := False;
  137.     STI; {OK, can change now}
  138.   END;
  139.  
  140.   FUNCTION Read_SKP : Byte;
  141.     (* ================================== *)
  142.     (* Returns the value of flag variable *)
  143.     (* "WHICH", and resets it to 0        *)
  144.     (* ================================== *)
  145.   BEGIN
  146.     CLI; {Don't want it changing DURING this!}
  147.     Read_SKP := which;
  148.     which := 0;
  149.     STI; {OK, can change now}
  150.   END;
  151.  
  152.   PROCEDURE Do_Demo;
  153.   BEGIN
  154.     ClrScr;
  155.     WriteLn('   KEYBOARD INTERRUPT DEMO "Shift Keys"');
  156.     WriteLn('   ====================================');
  157.     WriteLn;
  158.     Write('   Press the various shift keys on the ');
  159.     WriteLn('keyboard.  The normal "KeyPressed"');
  160.     Write('   function doesn''t notice these keys.  ');
  161.     WriteLn('But the new "ShiftKeyPressed"');
  162.     WriteLn('   notices!  Hit <Ctrl><Break> to quit.');
  163.     REPEAT
  164.       REPEAT UNTIL KeyPressed OR ShiftKeyPressed;
  165.       WHILE KeyPressed DO Write(ReadKey);
  166.       CASE Read_SKP OF
  167.         SC_LeftShift  : WriteLn('Left Shift');
  168.         SC_RightShift : WriteLn('Right Shift');
  169.         SC_CtrlShift  : WriteLn('Control Shift');
  170.         SC_AltShift   : WriteLn('Alt Shift');
  171.         SC_NumLock    : WriteLn('Num Lock');
  172.         SC_ScrollLock : WriteLn('Scroll Lock');
  173.         SC_CapsLock   : WriteLn('Caps Lock');
  174.       END;
  175.     UNTIL False;          {Only way out is ^Break}
  176.   END;
  177.  
  178. BEGIN
  179.   CheckBreak := True;
  180.   GetIntVec(Kbd_Int, Kbd_Vec);   {save "old" INT9}
  181.   SetIntVec(Kbd_Int, @INT9_ISR); {install new}
  182.   Exit_Vec := ExitProc;          {save old ExitProc}
  183.   ExitProc := @My_Exit;          {install new}
  184.   Do_Demo;                       {show yer stuff!}
  185. END.
  186.  
  187. Fig. D -- An Interrupt Procedure that replaces Interrupt 16h
  188.  
  189. PROGRAM New_I16;
  190.   Uses crt, dos, hexx;
  191.   (*The hexx Unit is described elsewhere in this article*)
  192. VAR
  193.   Kbd_Vec, Exit_Vec : pointer;
  194. CONST
  195.   Kbd_Int = $16;
  196.  
  197.   {$F+} PROCEDURE My_Exit;   {$F-}
  198.   BEGIN
  199.     SetIntVec(Kbd_Int, Kbd_vec); {restore OLD INT16}
  200.     IF (ExitCode <> 0) OR (ErrorAddr <> NIL) THEN
  201.       BEGIN
  202.         Assign(Output, '');
  203.         Rewrite(Output);
  204.         WriteLn(#7);
  205.         IF ExitCode = $FF THEN
  206.           WriteLn('USER BREAK')
  207.         ELSE
  208.           BEGIN
  209.             Write('Critical Error # ', HEX(ExitCode));
  210.             Write(' AT PROGRAM LOCATION ');
  211.             WriteLn(Hex(Seg(ErrorAddr^)), ':', Hex(Ofs(ErrorAddr^)));
  212.           END;
  213.       END;
  214.     ExitProc := Exit_Vec;     {restore previous ExitProc}
  215.   END;
  216.  
  217.  
  218.   PROCEDURE CLI; INLINE($FA); {INLINE procedures are NICE!}
  219.   PROCEDURE STI; INLINE($FB);
  220.   PROCEDURE NOP; INLINE($90);
  221.  
  222.   PROCEDURE INT16_ISR(_Flags, _CS, _IP, _AX, _BX, _CX, _DX,
  223.                               _SI, _DI, _DS, _ES, _BP : word);
  224.     INTERRUPT;
  225.   (*THIS procedure simply duplicates the function of (un-enhanced BIOS)
  226.     INT 16h.  But it does it totally using Turbo Pascal!*)
  227.   CONST
  228.     Zero_Flag = $40;
  229.     BIOS_Data = $40;
  230.   VAR
  231.     Buffer_Head  : Integer ABSOLUTE BIOS_Data : $001A;
  232.     Buffer_Tail  : Integer ABSOLUTE BIOS_Data : $001C;
  233.     Buffer_Start : Integer ABSOLUTE BIOS_Data : $0080;
  234.     Buffer_End   : Integer ABSOLUTE BIOS_Data : $0082;
  235.     KB_Flag      : Byte ABSOLUTE BIOS_Data : $0017;
  236.   BEGIN
  237.     STI;
  238.     CASE Hi(_AX) OF
  239.       0 : BEGIN         (*Read key (wait for it)*)
  240.             REPEAT
  241.               STI; NOP; CLI;
  242.             UNTIL Buffer_Head <> Buffer_Tail;
  243.             _AX := MemW[BIOS_Data : Buffer_Head];
  244.             INC(Buffer_Head, 2);
  245.             IF Buffer_Head > Buffer_End THEN
  246.               Buffer_Head := Buffer_Start;
  247.             STI;
  248.           END;
  249.       1 : BEGIN         (* Was a key pressed?*)
  250.             CLI;
  251.             IF Buffer_Head = Buffer_Tail THEN
  252.               _Flags := _Flags OR Zero_Flag
  253.             ELSE
  254.               BEGIN
  255.                 _Flags := _Flags AND NOT(Zero_Flag);
  256.                 _AX := MemW[BIOS_Data:Buffer_Head];
  257.               END;
  258.             STI;
  259.           END;
  260.       2 : _AX := KB_Flag; (*Return shift states*)
  261.     END;
  262.   END;
  263.  
  264.   PROCEDURE Do_Demo;
  265.   VAR
  266.     CH : Char;
  267.     L : STRING[255];
  268.     I : Integer;
  269.   BEGIN
  270.     WriteLn('Replacement keyboard interrupt is installed.');
  271.     Write('PRESS any key to continue....');
  272.     REPEAT UNTIL KeyPressed;
  273.     CH := ReadKey;
  274.     WriteLn(CH);
  275.     Write('Enter your name: ');
  276.     ReadLn(L);
  277.     WriteLn('Hi, ', L);
  278.     Write('Enter an integer: ');
  279.     ReadLn(I);
  280.     WriteLn('You entered ', I);
  281.   END;
  282.  
  283. BEGIN
  284.   ClrScr;
  285.   CheckBreak := True;
  286.   GetIntVec(Kbd_Int, Kbd_Vec);    {save "old" INT16}
  287.   SetIntVec(Kbd_Int, @INT16_ISR); {install new}
  288.   Exit_Vec := ExitProc;           {save old ExitProc}
  289.   ExitProc := @My_Exit;           {install new}
  290.   Do_Demo;                        {show yer stuff!}
  291.   {The interrupt gets restored in the ExitProc}
  292. END.
  293.  
  294. Fig. E -- One way to call a procedure within INLINE code
  295.  
  296. PROGRAM ProcParmDemo;
  297. VAR P : pointer;
  298.  
  299. {$F+}
  300.  PROCEDURE aproc;
  301.  BEGIN
  302.    WriteLn('I am a procedure!');
  303.  END;
  304. {$F-}
  305.  
  306. PROCEDURE Call(Pro : pointer);
  307.  BEGIN
  308.    INLINE($FF/$5E/$04); {CALL FAR [BP+4]}
  309.  END;
  310.  
  311. BEGIN
  312.  P := @aproc;
  313.  call(P);
  314. END.
  315.  
  316. Fig. F -- Fast keypress detection using an INLINE directive 
  317.  
  318. PROGRAM InlineDirective1;
  319.   USES crt;
  320. VAR
  321.   CH : Char;
  322.   count : LongInt;
  323.  
  324.   PROCEDURE FastKey; INLINE
  325.       ($31/$C0/                {XOR AX,AX}
  326.        $8E/$C0/                {MOV ES,AX}
  327.        $26/$A1/$1A/$04/        {MOV AX,ES:[041A]}
  328.        $26/$3B/$06/$1C/$04/    {CMP AX,ES:[041C]}
  329.        $74/$03);               {JZ  $+3}
  330.  
  331.   PROCEDURE GetCh;
  332.   BEGIN CH := UpCase(ReadKey); END;
  333.  
  334. BEGIN
  335.   WriteLn('Press any key to start, "Q" to Quit');
  336.   CH := ReadKey;
  337.   WriteLn('Looping....');
  338.   CH := #0;
  339.   count := 0;
  340.   REPEAT
  341.     FastKey;
  342.     GetCh;
  343.     Inc(Count);
  344.   UNTIL CH = 'Q';
  345.   WriteLn('IN that time I performed ', count, ' repetitions');
  346. END.
  347.  
  348. Fig. G -- An INLINE directive with arguments
  349.  
  350. PROGRAM LongMulDemo;
  351. VAR
  352.   X, Y : Integer;
  353.  
  354.   FUNCTION LongMul(X, Y : Integer) : LongInt;
  355.     (* Turbo pushes X and Y on the stack *)
  356.   INLINE(
  357.     $58/                    {POP AX  ;Pop Y }
  358.     $5A/                    {POP DX  ;Pop X }
  359.     $F7/$EA);               {IMUL DX ;Result in DX:AX = X*Y}
  360.  
  361. BEGIN
  362.   X := MaxInt; Y := MaxInt;
  363.   WriteLn('X is ', X, ' and Y is ', Y);
  364.   WriteLn('X*Y=', X*Y, ' -- wrong because it''s truncated to integer.');
  365.   WriteLn('LongMul(X,Y)=', LongMul(X, Y));
  366.   WriteLn('LongInt(X)*Y=', LongInt(X)*Y);
  367. END.
  368.  
  369. Fig. H -- Example of a shared data type for inter-process communication
  370.  
  371. TYPE
  372.   PassData = RECORD
  373.     ID           : string[8];
  374.     status       : Integer;
  375.     DataFileName : string[64];
  376.   END;
  377.  
  378. Fig. I -- An ExitProc gets control when the program ends.
  379.  
  380. {$R+}
  381. PROGRAM Exit_Proc_Demo;
  382.   USES Crt, hexx;
  383.   (*The hexx Unit is described elsewhere in this article*)
  384. VAR
  385.   ExitVec : Pointer;
  386.   W : Word;
  387.  
  388.   {$F+} PROCEDURE My_ExitProc; {$F-}
  389.   BEGIN
  390.     IF (ExitCode <> 0) OR (ErrorAddr <> NIL) THEN
  391.       BEGIN
  392.         Assign(Output, '');   (*Use DOS Standard Output*)
  393.         Rewrite(Output);
  394.         Write(#7'Abnormal exit:  ');
  395.         IF ExitCode = $FF THEN
  396.           WriteLn('USER BREAK')
  397.         ELSE
  398.           BEGIN
  399.             Write('Critical Error # ', HEX(ExitCode));
  400.             Write(' at program location ');
  401.             WriteLn(HEX(Seg(ErrorAddr^)), ':', Hex(Ofs(ErrorAddr^)));
  402.           END;
  403.       END
  404.     ELSE WriteLn('Normal exit.  ');
  405.     ExitProc := ExitVec;      {restore previous ExitProc}
  406.   END;
  407.  
  408. BEGIN
  409.   CheckBreak := True;
  410.   ExitVec := ExitProc;
  411.   ExitProc := @My_ExitProc;
  412.   WriteLn('Enter a WORD value:');
  413.   ReadLn(W);
  414. END.
  415.  
  416. Fig. J -- The TextRec TYPE corresponds to the structure of a TEXT file variable
  417.  
  418. TYPE
  419.   CharBuf = array[0..127] of char;
  420.   TextRec = RECORD
  421.     Handle    : Word;
  422.     Mode      : Word;
  423.     BufSize   : Word;
  424.     Private   : Word;
  425.     BufPos    : Word;
  426.     BufEnd    : Word;
  427.     BufPtr    : ^CharBuf;
  428.     OpenFunc  : pointer;
  429.     InOutFunc : pointer;
  430.     FlushFunc : pointer;
  431.     CloseFunc : pointer;
  432.     UserData  : Array[1..16] of byte;
  433.     Name      : Array[0..79] of char;
  434.     Buffer    : CharBuf;
  435.   END;
  436.  
  437. Fig. K -- Using a simulated text file to convert any number of variables into a
  438. single string variable
  439.  
  440. PROGRAM Usr_file;
  441.   USES Crt;
  442. CONST
  443.   UsrSiz = 255;
  444.   fmClosed = $D7B0;           {"magic" internal codes for TP4}
  445.   fmInput = $D7B1;
  446.   fmOutput = $D7B2;
  447.   fmInOut = $D7B3;
  448.   IO_NotOutput = $104;
  449.   IO_FileFull = $FB;          {You wrote > 255 characters}
  450.   IO_Invalid = $FC;           {You attempted an invalid operation}
  451. TYPE
  452.   String255 = STRING[255];
  453.   CharBuf = ARRAY[0..127] OF Char;
  454.   FakeFile = ARRAY[0..UsrSiz] OF Char;
  455.   TextRec = RECORD
  456.               Handle    : Word;
  457.               Mode      : Word;
  458.               BufSize   : Word;
  459.               Private   : Word;
  460.               BufPos    : Word;
  461.               BufEnd    : Word;
  462.               BufPtr    : ^CharBuf;
  463.               OpenFunc  : pointer;
  464.               InOutFunc : pointer;
  465.               FlushFunc : pointer;
  466.               CloseFunc : pointer;
  467.               {16 bytes for User Data.  We use
  468.               8 of them}
  469.               UFilePos  : Word;
  470.               UFileSiz  : Word;
  471.               Data      : ^FakeFile;
  472.               UserData  : ARRAY[1..8] OF Byte;
  473.               Name      : ARRAY[0..79] OF Char;
  474.               Buffer    : CharBuf;
  475.             END;
  476. VAR
  477.   UsrFile : Text;
  478.   CH      : Char;
  479.   N, D    : Integer;
  480.  
  481.   {$F+} {Compile functions as FAR routines}
  482.   FUNCTION UsrClose(VAR F : TextRec) : Integer;
  483.     (* "Closes" the UsrFile by deallocating its buffer. *)
  484.     (* Always returns 0, meaning success.               *)
  485.   BEGIN
  486.     Dispose(F.data);
  487.     UsrClose := 0;
  488.   END;
  489.  
  490.   FUNCTION UsrOutput(VAR F : TextRec) : Integer;
  491.     (* Output to the "file" consists of moving characters from *)
  492.     (* the built-in TextRec buffer to the outside buffer and   *)
  493.     (* adjusting the appropriate pointers.                     *)
  494.   BEGIN
  495.     UsrOutput := 0;
  496.     WITH F DO
  497.       IF mode = fmOutput THEN
  498.         BEGIN
  499.           IF UFilePos+BufPos >= UsrSiz THEN UsrOutput := IO_FileFull
  500.           ELSE
  501.             BEGIN
  502.               Move(BufPtr^, Data^[UFilePos], BufPos);
  503.               UFilePos := UFilePos+BufPos;
  504.               IF UFilePos > UFileSiz THEN UFileSiz := UFilePos;
  505.               BufPos := 0;
  506.             END;
  507.         END
  508.       ELSE
  509.         IF mode = fmClosed THEN UsrOutput := IO_NotOutput
  510.         ELSE UsrOutput := IO_Invalid;
  511.   END;
  512.  
  513.   FUNCTION UsrOpen(VAR F : TextRec) : Integer;
  514.     (* This particular kind of "file" can _only_ be opened with *)
  515.     (* ReWrite, never with Reset.                               *)
  516.   BEGIN
  517.     UsrOpen := 0;
  518.     WITH F DO
  519.       IF mode = fmOutput THEN
  520.         BEGIN
  521.           UFileSiz := 0;
  522.           UFilePos := 0;
  523.         END
  524.       ELSE UsrOpen := IO_Invalid;
  525.   END;
  526.   {$F-}{Stop compiling functions as FAR routines}
  527.  
  528.   FUNCTION ReadUsr(VAR F : Text) : String255;
  529.     (* Grab the entire contents of the UsrFile and reset it *)
  530.     (* to empty.                                            *)
  531.   VAR Temp : String255;
  532.   BEGIN
  533.     WITH TextRec(F) DO
  534.       BEGIN
  535.         Move(Data^, Temp[1], UFileSiz);
  536.         Temp[0] := Chr(UFileSiz);
  537.         UFileSiz := 0;
  538.         UFilePos := 0;
  539.       END;
  540.     ReadUsr := temp;
  541.   END;
  542.  
  543.   PROCEDURE AssignUsr(VAR F : Text);
  544.   BEGIN
  545.     WITH TextRec(F) DO
  546.       BEGIN
  547.         Mode := fmClosed;
  548.         BufSize := 127;
  549.         BufPtr := @buffer;
  550.         OpenFunc := @UsrOpen;
  551.         CloseFunc := @UsrClose;
  552.         InOutFunc := @UsrOutput;
  553.         FlushFunc := @UsrOutput;
  554.         Name[0] := #0;
  555.         UFileSiz := 0;
  556.         UFilePos := 0;
  557.         New(Data);
  558.       END;
  559.   END;
  560.  
  561. BEGIN
  562.   ClrScr;
  563.   Write('Now writing several variables to "UsrFile" -- ');
  564.   WriteLn('they will become a single STRING.');
  565.   AssignUsr(UsrFile);
  566.   Rewrite(UsrFile);
  567.   Write(UsrFile, 'PI/4 = ', Pi/4:1:11);
  568.   Write(UsrFile, '  The biggest Long Integer is ', MaxLongInt);
  569.   WriteLn('Press a key to see the result.');
  570.   CH := ReadKey;
  571.   WriteLn; WriteLn('"', ReadUsr(UsrFile), '"'); WriteLn;
  572.   WriteLn('Now the UsrFile is clear, ready to accept input again');
  573.   N := 355; D := 113;
  574.   Write(UsrFile, N, '/', D, ' ', Chr(247), ' PI.');
  575.   Write(UsrFile, ' PI=', Pi:1:11, ' and ', N, '/', D, '=', N/D:1:11);
  576.   WriteLn('Press a key to see the result.');
  577.   CH := ReadKey;
  578.   WriteLn; WriteLn('"', ReadUsr(UsrFile), '"'); WriteLn;
  579.   WriteLn('NOW to overload the UsrFile -- we will get a special I/O error');
  580.   WriteLn('Press a key to see the result.');
  581.   CH := ReadKey;
  582.   FOR N := 1 TO 9 DO
  583.     Write(UsrFile, 'THIS string has 32 characters. ');
  584.   WriteLn; WriteLn('"', ReadUsr(UsrFile), '"'); WriteLn;
  585. END.
  586.  
  587. Fig. L -- Using a "fake OBJ" to incorporate a data file directly into a program.
  588.  
  589. PROGRAM Fake_Obj;
  590.  
  591.   {$L INFO.OBJ}
  592.   PROCEDURE InfoProc; EXTERNAL;
  593.  
  594.   PROCEDURE DisplayInfo(P : Pointer);
  595.   VAR N : Integer;
  596.     S,O : Word;
  597.   BEGIN
  598.     N := -1;
  599.     S := Seg(P^);
  600.     O := Ofs(P^);
  601.     REPEAT
  602.       Inc(N);
  603.       Write(Chr(MEM[S:O+N]));
  604.     UNTIL (MEM[S:O+succ(N)]) = 26;
  605.   END;
  606.  
  607. BEGIN
  608.   DisplayInfo(@InfoProc);
  609. END.
  610.  
  611. Fig. M -- TP4 offers conditional compilation
  612.  
  613. PROGRAM CondComp;
  614. {$IFDEF CPU87}
  615. {$N+}  { turn on use of 8087 math package }
  616. VAR
  617.   X : Single;   { single precision IEEE real }
  618.   Y : Double;   { double precision IEEE real }
  619.   Z : Extended; { extended IEEE real         }
  620. {$ELSE}
  621. VAR
  622.   X : Real;  { no 8087 so define all of them as 6 byte }
  623.   Y : Real;  { reals }
  624.   Z : Real;
  625. {$ENDIF}
  626.  
  627. BEGIN
  628.   WriteLn('X takes ', SizeOf(X), ' bytes.');
  629.   WriteLn('Y takes ', SizeOf(Y), ' bytes.');
  630.   WriteLn('Z takes ', SizeOf(Z), ' bytes.');
  631. END.
  632.  
  633. Fig. N -- Demonstrating TP4's direct video I/O
  634.  
  635. PROGRAM FastWrite;
  636. Uses Crt;
  637. VAR
  638.   AString : String[79];
  639.   N       : Byte;
  640.  
  641. BEGIN
  642.   FOR N := 1 to 79 DO AString[N] := 'O';
  643.   AString[0] := #79;
  644.   ClrScr;
  645.   WriteLn('Press <Return> for a demo of fast screen writing');
  646.   ReadLn; GotoXY(1,1);
  647.   LowVideo;
  648.   FOR N := 1 to 24 DO WriteLn(AString);
  649.   FOR N := 1 to 79 DO AString[N] := 'X';
  650.   GotoXY(1,1); NormVideo;
  651.   WriteLn('Press <Return> for a demo of ordinary writing');
  652.   ReadLn; GotoXY(1,1);
  653.   DirectVideo := False;
  654.   FOR N := 1 to 24 DO WriteLn(AString);
  655. END.
  656.  
  657. Fig O. -- A simple UNIT for hexadecimal conversions
  658.  
  659. UNIT Hexx;
  660.  
  661. Interface
  662. TYPE
  663.   string2 = STRING[2];
  664.   string4 = STRING[4];
  665.  
  666. CONST
  667.   HexDigit : ARRAY[0..15] OF Char = '0123456789ABCDEF';
  668.  
  669.   FUNCTION HexByte(B : Byte) : string2;
  670.   FUNCTION Hex(I : Integer) : string4;
  671.  
  672.  Implementation
  673.  
  674.   FUNCTION HexByte(B : Byte) : string2;
  675.   BEGIN
  676.     HexByte := HexDigit[B SHR 4]+HexDigit[B AND $F];
  677.   END;
  678.  
  679.   FUNCTION Hex(I : Integer) : string4;
  680.   BEGIN
  681.     Hex := HexByte(Hi(I))+HexByte(Lo(I));
  682.   END;
  683. END.
  684.